BasinArea Subroutine

private recursive subroutine BasinArea(r, c, fdir, area)

compute basin area (m2)

Arguments

Type IntentOptional Attributes Name
integer, intent(in) :: r
integer, intent(in) :: c
type(grid_integer), intent(in) :: fdir
real(kind=float), intent(inout) :: area

Source Code

RECURSIVE SUBROUTINE BasinArea &
!
(r, c, fdir, area)

IMPLICIT NONE

TYPE(grid_integer),INTENT(IN) :: fdir
INTEGER, INTENt(in) :: r,c 
REAL (KIND = float), INTENT(inout) :: area
!------------------------------end of declaration -----------------------------

IF ( .NOT. IsOutOfGrid(r,c+1,fdir) ) THEN
    IF(fdir%mat(r,c+1) == W) THEN
       area = area + CellArea (fdir, r, c+1)
       CALL BasinArea (r,c+1,fdir,area)
    END IF
END IF

IF ( .NOT. IsOutOfGrid(r+1,c+1,fdir) ) THEN
    IF(fdir%mat(r+1,c+1) == NW ) THEN
       area = area + CellArea (fdir, r+1, c+1)
       CALL BasinArea (r+1,c+1,fdir,area)
    END IF
END IF

IF ( .NOT. IsOutOfGrid(r+1,c,fdir) ) THEN
    IF(fdir%mat(r+1,c) == N ) THEN
       area = area + CellArea (fdir, r+1, c)
       CALL BasinArea (r+1,c,fdir,area)
    END IF
END IF

IF ( .NOT. IsOutOfGrid(r+1,c-1,fdir) ) THEN
    IF(fdir%mat(r+1,c-1) == NE ) THEN
       area = area + CellArea (fdir, r+1, c-1)
       CALL BasinArea (r+1,c-1,fdir,area)
    END IF
END IF

IF ( .NOT. IsOutOfGrid(r,c-1,fdir) ) THEN
    IF(fdir%mat(r,c-1) == E) THEN
        area = area + CellArea (fdir, r, c-1)
        CALL BasinArea (r,c-1,fdir,area)
    END IF
END IF

IF ( .NOT. IsOutOfGrid(r-1,c-1,fdir) ) THEN
    IF(fdir%mat(r-1,c-1) == SE ) THEN
       area = area + CellArea (fdir, r-1, c-1)
       CALL BasinArea (r-1,c-1,fdir,area)
    END IF
END IF

IF ( .NOT. IsOutOfGrid(r-1,c,fdir) ) THEN
    IF(fdir%mat(r-1,c) == S ) THEN
       area = area + CellArea (fdir, r-1, c)
       CALL BasinArea (r-1,c,fdir,area)
    END IF
END IF

IF ( .NOT. IsOutOfGrid(r-1,c+1,fdir) ) THEN
    IF(fdir%mat(r-1,c+1) == SW ) THEN
       area = area + CellArea (fdir, r-1, c+1)
       CALL BasinArea (r-1,c+1,fdir,area) 
    END IF
END IF

END SUBROUTINE BasinArea